procedure dfs(v,p:longint);

var
  tt,i,tto,j:longint;

begin
cl[v] := 1;
inc(cs);
st[cs] := v;
tt := length(g[v]) - 1;
for i := 0 to tt do begin
  tto := g[v][i];
  if tto = p then continue;
  if cl[tto] = 0 then dfs(tto,v) else
  if cl[tto] = 1 then begin
    f := true;
    lc := 0;
    j := cs;
    while st[j] <> tto do begin
      inc(lc);
      loop[lc] := st[j];
      dec(j);
    end;
    inc(lc);
    loop[lc] := st[j];
    dec(j);
    cs := 0;
  end;
end;
if cs > 0 then dec(cs);
cl[v] := 2;
end;

procedure findLoops();
begin
fillchar(cl,sizeof(cl),0);
cs := 0;
f := false;
dfs(1,0);
end;